home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 16 / polygons.fth < prev    next >
Text File  |  1985-11-19  |  3KB  |  88 lines
  1. \ Sliding polygons demo.  Load this file and type   poly-demo
  2. \ 
  3. \ Type any key to stop it.
  4. \
  5. \ The demo initially draws triangles.  By typing
  6. \    n vertices   poly-demo
  7. \ where 3 <= n < 64, you can change it to draw polygons with more vertices
  8.  
  9. needs line-a-init linea.fth
  10. line-a-init
  11. decimal
  12. 17 xbios: _random { -- l.rnd-number }  \ bios random number routine
  13.  5 xbios: _setscreen  { w.rez l.phyz l.log -- }
  14. 37 xbios: vsync { -- }  \ wait till next vertical retrace then return
  15.  
  16. : rnd  ( limit -- rndnum )  \ return random number up to limit
  17.    _random swap  mod
  18. ;
  19.  
  20. scradr constant old-screen
  21. get-rez
  22. constant cury
  23. constant curx
  24.  
  25. create source-buff  256 allot
  26. create dest-buff  256 allot
  27. create spare-buff  256 allot
  28. create new-scr-buff  1024 32 * 512 + allot
  29. new-scr-buff 512 mod 512 swap - new-scr-buff + constant new-screen
  30. variable keep-going keep-going on
  31. variable #verts  3 #verts !
  32.  
  33. : set-buf  ( addr -- )  \ randomize a buffer
  34.    dup #verts @ 0
  35.    do   curx rnd  over w! 2+  cury rnd  over w! 2+   loop
  36.    over w@ over w! 2+ swap 2+ w@  swap w!
  37. ;
  38.  
  39. : move-buf  ( -- )  \ convert one buffer to another
  40.    dest-buff  source-buff  keep-going off  #verts @ 1+  2* 0
  41.    do
  42.      dup w@  2 pick w@  2dup 2dup <> -rot 1+ <> and
  43.       if   over  > 
  44.         if   2+
  45.         else 2-
  46.         then over w!  keep-going on
  47.       else 2drop
  48.       then 2+  swap  2+  swap
  49.    loop  2drop
  50. ;
  51. : draw-source ( -- )  \ draw the source polygon
  52.    source-buff #verts @  poly-line 
  53. ;
  54. : vertices  ( n -- )  \ set the number of vertices
  55.    #verts !
  56. ;
  57. : poly-demo
  58.    27 emit ascii f emit
  59.    -1 -1 new-screen _setscreen  erase-screen
  60.    -1 -1 old-screen _setscreen  erase-screen
  61.    2 _wrt_mod w!  
  62.    dest-buff set-buf  source-buff set-buf  
  63.    -1 new-screen old-screen _setscreen vsync draw-source  
  64.    -1 old-screen new-screen _setscreen vsync draw-source  
  65.    source-buff spare-buff  #verts @ 1+ 4 * cmove
  66.    begin
  67.     begin
  68.         -1 old-screen new-screen  _setscreen
  69.         spare-buff #verts @ vsync poly-line        
  70.         source-buff spare-buff  #verts @ 1+ 4 * cmove
  71.         move-buf  draw-source 
  72.  
  73.         -1 new-screen old-screen  _setscreen
  74.         spare-buff #verts @ vsync poly-line        
  75.         source-buff spare-buff  #verts @ 1+ 4 * cmove
  76.         move-buf  draw-source 
  77.         key?
  78.         if  -1 old-screen old-screen _setscreen
  79.             27 emit ascii e emit exit  
  80.         then
  81.           keep-going @ 0=
  82.     until  dest-buff set-buf 
  83.    again
  84. ;
  85.  -) move
  86. c;
  87.  
  88. : ne